{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Animators;

interface

uses Classes, UIObjects, Colours, XMLHelper, AHMTypes;

const
  ANIM_PARAM_START_GAMMA = 'start.gamma';
  ANIM_PARAM_FINISH_GAMMA = 'finish.gamma';
  ANIM_PARAM_START_POS = 'start.position';
  ANIM_PARAM_FINISH_POS = 'finish.position';
  ANIM_PARAM_START_SIZE = 'start.size';
  ANIM_PARAM_FINISH_SIZE = 'finish.size';
  ANIM_PARAM_START_SCALE = 'start.scale';
  ANIM_PARAM_FINISH_SCALE = 'finish.scale';
  ANIM_PARAM_MACRO_NAME = 'macro.name';
  ANIM_PARAM_FUNCTION_NAME = 'function.name';
  ANIM_PARAM_FUNCTION_TARGET = 'function.target';
  ANIM_PARAM_FUNCTION_PARAM = 'function.parameter';

{$IFDEF DESIGNER}
  MODIFY_CAPTION = 'Edit Animations';

  // Property categories and hints for designer
  CAT_ANIMATOR = 'Animator';
  HINT_ANIMATIONS = 'defines a sequence of animation steps for this animator';
{$ENDIF}

type
  TAHMAnimation = class(TAHMUIObject)
  private
    FType: TAHMAnimationType;
    FDuration: Integer;
    FConcurrent: Boolean;
    FPersistent: Boolean;
    FBreakable: Boolean;
    FParams: TStringList;
  protected
    procedure SetAnimationType(AnimationType: TAHMAnimationType);
    procedure SetDuration(Duration: Integer);
    procedure SetConcurrent(Concurrent: Boolean);
    procedure RefreshName;
    function GetDesignerInfo: String; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    property AnimationType: TAHMAnimationType read FType write SetAnimationType;
    property Duration: Integer read FDuration write SetDuration;
    property Concurrent: Boolean read FConcurrent write SetConcurrent;
    property Persistent: Boolean read FPersistent write FPersistent;
    property Breakable: Boolean read FBreakable write FBreakable;
    property Parameters: TStringList read FParams;
    procedure Assign(Source: TPersistent); override;
    procedure AddParameter(Name, Value: String);
    function GetParameter(Name: String): String;
    procedure SaveAsXML(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
  end;

  TAHMAnimationList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddAnimation(const InheritFrom, NewName: String): TAHMAnimation;
    function GetAnimation(const Name: String): TAHMAnimation; overload;
    function GetAnimation(Index: Integer): TAHMAnimation; overload;
    function Modify: Boolean; override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
  end;

  TAHMAnimator = class(TAHMUIObject)
  private
    FAnimations: TAHMAnimationList;
  protected
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    function RenderPreview: Boolean; override;
    function ModifyActions: Integer; override;
    function Modify(Action: Integer): Boolean; override;
    function ModifyCaption(Action: Integer): String; override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property Animations: TAHMAnimationList read FAnimations;
  end;

  TAHMAnimatorList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddAnimator(const InheritFrom, NewName: String): TAHMAnimator;
    function GetAnimator(const Name: String): TAHMAnimator;
  end;


implementation

uses SysUtils, ApplicationManager, UIManager, Screen, Canvas, BaseControls,
     UIControls, {$IFDEF DESIGNER}DesignerList,{$ENDIF} TagNames, XMLTags;

constructor TAHMAnimation.Create(const Name: String);
begin
  inherited;

  ImageIndex := Ord(otAnimators);
  FParams := TStringList.Create;
end;

destructor TAHMAnimation.Destroy;
begin
  FParams.Free;

  inherited;
end;

procedure TAHMAnimation.SetAnimationType(AnimationType: TAHMAnimationType);
begin
  FType := AnimationType;

  // Pause animations and derived classes are never concurrent
  if FType in [atPause, atMacro, atFunction] then FConcurrent := False;

  RefreshName;
end;

procedure TAHMAnimation.SetDuration(Duration: Integer);
begin
  FDuration := Duration;
  RefreshName;
end;

procedure TAHMAnimation.SetConcurrent(Concurrent: Boolean);
begin
  // Pause animations and derived classes are never concurrent
  if FType in [atPause, atMacro, atFunction] then FConcurrent := False
                                             else FConcurrent := Concurrent;
  RefreshName;
end;

procedure TAHMAnimation.RefreshName;
var
  Name: String;
begin
  // Name is derived from animation type and duration
  Name := AnimationType2Str(FType) + ' ';
  if Name <> '' then Name[1] := Upcase(Name[1]);

  // Indicate concurrency
  if FConcurrent then Rename(Name + IntToStr(FDuration) + ' ms...')
                 else Rename('...' + Name + IntToStr(FDuration) + 'ms');
end;

function TAHMAnimation.GetDesignerInfo: String;
begin
  // Build info for designer list form
  with FParams do
    case FType of
      atSize:     Result := 'Start: ' + Values[ANIM_PARAM_START_SIZE] + ', ' +
                            'Finish: ' + Values[ANIM_PARAM_FINISH_SIZE];
      atSlide:    Result := 'Start: ' + Values[ANIM_PARAM_START_POS] + ', ' +
                            'Finish: ' + Values[ANIM_PARAM_FINISH_POS];
      atRotate:   Result := 'Start: ' + Values[ANIM_PARAM_START_POS] + ', ' +
                            'Finish: ' + Values[ANIM_PARAM_FINISH_POS];
      atScale:    Result := 'Start: ' + Values[ANIM_PARAM_START_SCALE] + ', ' +
                            'Finish: ' + Values[ANIM_PARAM_FINISH_SCALE];
      atFadeIn:   Result := 'Start: ' + Values[ANIM_PARAM_START_GAMMA] + ', ' +
                            'Finish: ' + Values[ANIM_PARAM_FINISH_GAMMA];
      atFadeOut:  Result := 'Start: ' + Values[ANIM_PARAM_START_GAMMA] + ', ' +
                            'Finish: ' + Values[ANIM_PARAM_FINISH_GAMMA];
      atMacro:    Result := 'Macro: ' + Values[ANIM_PARAM_MACRO_NAME];
      atFunction: Result := Values[ANIM_PARAM_FUNCTION_NAME] + ': ' +
                            Values[ANIM_PARAM_FUNCTION_TARGET] + ', ' +
                            Values[ANIM_PARAM_FUNCTION_PARAM];
      else Result := '';
    end;
end;

procedure TAHMAnimation.Assign(Source: TPersistent);
begin
  inherited;

  // Assign properties from passed source animation
  with Source as TAHMAnimation do
  begin
    Self.AnimationType := AnimationType;
    Self.Duration := Duration;
    Self.Concurrent := Concurrent;
    Self.Persistent := Persistent;
    Self.Breakable := Breakable;
    Self.Parameters.Assign(Parameters);
  end;
end;

procedure TAHMAnimation.AddParameter(Name, Value: String);
var
  i: Integer;
begin
  with FParams do
  begin
    i := IndexOfName(Name);
    if i <> -1 then Delete(i);
    Add(Name + NameValueSeparator + Value);
  end;
end;

function TAHMAnimation.GetParameter(Name: String): String;
begin
  Result := FParams.Values[Name];
end;

procedure TAHMAnimation.SaveAsXML(Lines: TStrings);
var
  sWork: String;
  i: Integer;
begin
  // Store animation type
  sWork := TGB+TAG_ANIMATION+SPC+ATTR_TYPE+ATB + AnimationType2Str(FType) + ATQ;

  // Store animation duration if set
  if FDuration <> 0 then
    sWork := sWork + SPC+ATTR_DURATION+ATB + IntToStr(FDuration) + ATQ;

  // Store animation concurrency & persistence
  if FConcurrent then
    sWork := sWork + SPC+ATTR_CONCURRENT+ATB + Bool2Str(FConcurrent) + ATQ;
  if FPersistent then
    sWork := sWork + SPC+ATTR_PERSISTENT+ATB + Bool2Str(FPersistent) + ATQ;
  if FBreakable then
    sWork := sWork + SPC+ATTR_BREAKABLE+ATB + Bool2Str(FBreakable) + ATQ;

  // Does this animation have any parameters to store?
  if FParams.Count = 0 then
    Lines.Add(TABS[3] + sWork + ETE)
  else
  begin
    // Iterate through each parameter for this animation step
    Lines.Add(TABS[3] + sWork + TGC);
    for i := 0 to Pred(FParams.Count) do
    begin
      // Build up name/value attributes for parameter
      sWork := TGB+TAG_PARAMETER+SPC+ATTR_NAME+ATB + EncodeXML(FParams.Names[i]) + ATN;
      sWork := sWork + ATTR_VALUE+ATB + EncodeXML(FParams.ValueFromIndex[i]) + ATE;
      Lines.Add(TABS[4] + sWork);
    end;
    Lines.Add(TABS[3] + TGE+TAG_ANIMATION+TGC);
  end;
end;

procedure TAHMAnimation.ParseFromXML(XML: TAHMXMLHelper);
var
  sName, sValue: String;
  AnimNode, ParamNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  AnimNode := XML.CurrentNode;
  ParamNode := nil;

  // Get animation properties
  FDuration := StrToIntDef(XML.GetAttribute(ATTR_DURATION), 0);
  FConcurrent := Str2Bool(XML.GetAttribute(ATTR_CONCURRENT));
  FPersistent := Str2Bool(XML.GetAttribute(ATTR_PERSISTENT));

  // Provide default for omitted breakable attribute in legacy themes
  sValue := XML.GetAttribute(ATTR_BREAKABLE);
  if sValue <> '' then FBreakable := Str2Bool(sValue)
                  else FBreakable := not FPersistent;

  // Determine animation type
  AnimationType := Str2AnimationType(XML.GetAttribute(ATTR_TYPE));

  // Animation may have a number of optional parameter tags
  while XML.FindElement(AnimNode, ParamNode, TAG_PARAMETER) do
  begin
    // Get parameter properties
    sName := XML.GetAttribute(ATTR_NAME);
    sValue := XML.GetAttribute(ATTR_VALUE);
    AddParameter(sName, sValue);
  end;
end;

//----------------------------------------------------------------------------//

constructor TAHMAnimationList.Create;
begin
  inherited Create;

  ChildClass := TAHMAnimation;
  DefaultSort := lsNatural;
  FSpaceElements := False;
  XMLIndent := 1;
end;

function TAHMAnimationList.AddAnimation(const InheritFrom, NewName: String): TAHMAnimation;
begin
  Result := TAHMAnimation(Inherit(InheritFrom, NewName));
end;

function TAHMAnimationList.GetAnimation(const Name: String): TAHMAnimation;
begin
  Result := TAHMAnimation(GetObject(Name));
end;

function TAHMAnimationList.GetAnimation(Index: Integer): TAHMAnimation;
begin
  Result := TAHMAnimation(GetObject(Index));
end;

function TAHMAnimationList.Modify: Boolean;
begin
{$IFDEF DESIGNER}
  // Edit animations with list dialog
  Result := TfrmObjectList.ShowList(Self, nil, nil);
{$ELSE}
  Result := False;
{$ENDIF}
end;

procedure TAHMAnimationList.ParseFromXML(XML: TAHMXMLHelper);
var
  RootNode, ItemNode: TAHMXMLNode;
begin
  // Store description, comments & prepare for parsing
  RootNode := XML.CurrentNode;
  ItemNode := nil;

  // Keep going as long as we find child tags to process
  while XML.NextElement(RootNode, ItemNode) do
    ParseObjectFromXML(nil, XML);
end;

//----------------------------------------------------------------------------//

constructor TAHMAnimatorList.Create;
begin
  inherited Create;

  XMLTagName := TAG_ANIMATORS;
  ChildClass := TAHMAnimator;
end;

function TAHMAnimatorList.AddAnimator(const InheritFrom, NewName: String): TAHMAnimator;
begin
  Result := TAHMAnimator(Inherit(InheritFrom, NewName));
end;

function TAHMAnimatorList.GetAnimator(const Name: String): TAHMAnimator;
begin
  Result := TAHMAnimator(GetObject(Name));
end;

//----------------------------------------------------------------------------//

constructor TAHMAnimator.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_ANIMATOR;
  ObjectType := otAnimators;
  ImageIndex := Ord(otAnimators);

  FAnimations := TAHMAnimationList.Create;
end;

destructor TAHMAnimator.Destroy;
begin
  FAnimations.FreeWithContents;

  inherited Destroy;
end;

procedure TAHMAnimator.ClearProperties;
begin
  inherited;

  // Clear custom animator properties
  FAnimations.ClearObjects;
end;

function TAHMAnimator.RenderPreview: Boolean;
{$IFDEF DESIGNER}
var
  Control: TAHMControl;
{$ENDIF}
begin
{$IFDEF DESIGNER}
  with ApplicationManagerInstance, ScreenInstance.Viewport do
  begin
    Canvas.DesignerBackground(ViewportRect);
    Control := UIManager.GetPreviewControl(TAHMImageControl);

    // Restart animation if not currently running
    if not AnimationEngine.IsControlAnimating(PREVIEW_CONTROL_NAME, Self) then
    begin
      // Force reallocation of new bitmap control instance to reset the animation
      Control := UIManager.GetPreviewControl(TAHMImageControl, True);
      AnimationEngine.AnimateControl(PREVIEW_CONTROL_NAME, Self);
    end;

    Control.Render(ScreenInstance.Viewport);
  end;
{$ENDIF}
  Result := True;
end;

function TAHMAnimator.ModifyActions: Integer;
begin
  // Animator only supports editing animations
  Result := 1;
end;

function TAHMAnimator.Modify(Action: Integer): Boolean;
begin
{$IFDEF DESIGNER}
  // Edit animations with list dialog
  Result := TfrmObjectList.ShowList(FAnimations, nil, nil);
  if Result then DoModified;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TAHMAnimator.ModifyCaption(Action: Integer): String;
begin
{$IFDEF DESIGNER}
  Result := MODIFY_CAPTION;
{$ELSE}
  Result := '';
{$ENDIF}
end;

procedure TAHMAnimator.SeedObject;
{$IFDEF DESIGNER}
var
  Animation: TAHMAnimation;
{$ENDIF}
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
  begin
    Animation := Animations.AddAnimation('', 'Animation 1');
    Animation.AnimationType := atScale;
    Animation.Duration := 500;
    Animation.AddParameter(ANIM_PARAM_START_SCALE, '1');
    Animation.AddParameter(ANIM_PARAM_FINISH_SCALE, '2');
  end;
{$ENDIF}
end;

procedure TAHMAnimator.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMAnimator do
  begin
    Self.Animations.AssignContents(Animations);
  end;
end;

procedure TAHMAnimator.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMAnimator;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMAnimator(ObjectToCompare);

  // Save XML for animation steps
  FAnimations.SaveDiffsAsXML(oAncs.Animations, Lines);
end;

procedure TAHMAnimator.ParseFromXML(XML: TAHMXMLHelper);
begin
  // An animator consists of a number of animation tags
  FAnimations.ParseFromXML(XML);
end;

procedure TAHMAnimator.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom animator properties
  Properties.Add('Animations', 'Animations', CAT_ANIMATOR, HINT_ANIMATIONS);
{$ENDIF}
end;

end.

